home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / crtplu.zip / CRTPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  6KB  |  204 lines
  1. (***********************************************************)
  2. (*                                                         *)
  3. (*   CrtPlus Unit Revision 1.0                             *)
  4. (*   (c) 1991 by Modern Solutions.  All rights reserved.   *)
  5. (*                                                         *)
  6. (***********************************************************)
  7.  
  8. unit CrtPlus;
  9.  
  10. interface
  11.  
  12. uses dos;
  13.  
  14. const
  15.   videosegment:word=$b800;
  16.  
  17. function CGApresent:boolean;
  18. function MDApresent:boolean;
  19. function EGApresent:boolean;
  20. procedure Crt80x43;
  21. procedure Crt80x50;
  22. procedure BlinkingOff;
  23. procedure BlinkingOn;
  24. procedure BlockFill(x1,y1,x2,y2,fc,bc,ascii:integer);
  25. procedure BlockColor(x1,y1,x2,y2,fc,bc:integer);
  26. procedure BlockCopy(x1,y1,x2,y2,x3,y3:integer);
  27.  
  28. implementation
  29.  
  30. function CGApresent:boolean;
  31.  
  32. var
  33.   localCGApresent:boolean;
  34.  
  35. begin
  36.   inline($ba/$d4/$03/$f8/$b0/$0f/$ee/$42/$ec/$8a/$e0/$b0/$66/$ee/$b9/
  37.          $00/$01/$e2/$fe/$ec/$86/$e0/$ee/$80/$fc/$66/$74/$01/$f9/$72/
  38.          $09/$c7/$86/localCGApresent/$01/$00/$eb/$07/$90/$c7/$86/
  39.          localCGApresent/$00/$00);
  40.   CGApresent:=localCGApresent;
  41. end;
  42.  
  43. function MDApresent:boolean;
  44.  
  45. var
  46.   localMDApresent:boolean;
  47.  
  48. begin
  49.   inline($ba/$b4/$03/$f8/$b0/$0f/$ee/$42/$ec/$8a/$e0/$b0/$66/$ee/$b9/
  50.          $00/$01/$e2/$fe/$ec/$86/$e0/$ee/$80/$fc/$66/$74/$01/$f9/$72/
  51.          $09/$c7/$86/localMDApresent/$01/$00/$eb/$07/$90/$c7/$86/
  52.          localMDApresent/$00/$00);
  53.   MDApresent:=localMDApresent;
  54. end;
  55.  
  56. function EGApresent:boolean;
  57.  
  58. var
  59.   localEGApresent:boolean;
  60.  
  61. begin
  62.   inline($32/$d2/$b4/$12/$b3/$10/$cd/$10/$80/$fb/$10/$74/$07/$80/$fb/
  63.          $00/$74/$02/$b2/$01/$8a/$c2/$32/$e4/$89/$86/localEGApresent);
  64.   EGApresent:=localEGApresent;
  65. end;
  66.  
  67. procedure Crt80x43;
  68.  
  69. begin
  70.   inline($b8/$03/$00/$cd/$10/$b8/$12/$11/$b3/$00/$cd/$10/$b8/$40/$00/
  71.          $8e/$c0/$26/$8b/$16/$63/$00/$b8/$0a/$06/$ef/$b8/$0b/$00/$ef/
  72.          $b4/$12/$b3/$20/$cd/$10);
  73. end;
  74.  
  75. procedure Crt80x50;
  76.  
  77. begin
  78.   inline($b8/$02/$12/$b3/$30/$cd/$10/$b8/$03/$00/$cd/$10/$b8/$12/$11/
  79.          $b3/$00/$cd/$10);
  80. end;
  81.  
  82. procedure BlinkingOff;
  83.  
  84. var
  85.   regs:registers;
  86.  
  87. begin
  88.   if egapresent then
  89.     with regs do
  90.       begin
  91.         ax:=$1003;
  92.         bl:=0;
  93.         intr($10,regs);
  94.       end
  95.   else
  96.     inline($b8/$40/$00/$8e/$c0/$26/$8b/$16/$63/$00/$80/$c2/$04/$26/$a0/
  97.            $65/$00/$24/$df/$ee/$26/$a2/$65/$00);
  98. end;
  99.  
  100. procedure BlinkingOn;
  101.  
  102. var
  103.   regs:registers;
  104.  
  105. begin
  106.   if egapresent then
  107.     with regs do
  108.       begin
  109.         ax:=$1003;
  110.         bl:=1;
  111.         intr($10,regs);
  112.       end
  113.   else
  114.     inline($b8/$40/$00/$8e/$c0/$26/$8b/$16/$63/$00/$80/$c2/$04/$26/$a0/
  115.            $65/$00/$0c/$20/$ee/$26/$a2/$65/$00);
  116. end;
  117.  
  118. function ColortoAttribute(fc,bc:integer):integer;
  119.  
  120. begin
  121.   inline($8b/$9e/fc/$8b/$86/bc/$bf/$10/$00/$f7/$e7/$83/$fb/$10/
  122.          $7c/$06/$05/$80/$00/$83/$eb/$10/$03/$c3/$89/$86/colortoattribute);
  123. end;
  124.  
  125. function Locate(x,y:integer):integer;
  126.  
  127. begin
  128.   inline($8b/$be/y/$8b/$b6/x/$4f/$4e/$b8/$50/$00/
  129.          $f7/$e7/$03/$c6/$03/$c0/$89/$86/locate);
  130. end;
  131.  
  132. procedure BlockFill(x1,y1,x2,y2,fc,bc,ascii:integer);
  133.  
  134. var
  135.   upperleft,lowerright,attribute:integer;
  136.  
  137. begin
  138.   upperleft:=locate(x1,y1);
  139.   lowerright:=locate(x2,y2);
  140.   attribute:=colortoattribute(fc,bc);
  141.   inline($fc/$a1/videosegment/$8e/$c0/$8b/$be/upperleft/$8a/$86/
  142.          ascii/$8a/$a6/attribute/$8b/$96/x2/$2b/$96/x1/$42/$8b/
  143.          $ca/$f3/$ab/$2b/$fa/$2b/$fa/$81/$c7/$a0/$00/$3b/$be/
  144.          lowerright/$7e/$ee);
  145. end;
  146.  
  147. procedure BlockColor(x1,y1,x2,y2,fc,bc:integer);
  148.  
  149. var
  150.   upperleft,lowerright,attribute:integer;
  151.  
  152. begin
  153.   upperleft:=locate(x1,y1);
  154.   lowerright:=locate(x2,y2);
  155.   inc(upperleft);
  156.   inc(lowerright);
  157.   attribute:=colortoattribute(fc,bc);
  158.   inline($fc/$a1/videosegment/$8e/$c0/$8b/$be/upperleft/$8a/$86/
  159.          attribute/$8b/$96/x2/$2b/$96/x1/$42/$8b/$ca/$aa/$47/$e2/
  160.          $fc/$2b/$fa/$2b/$fa/$81/$c7/$a0/$00/$3b/$be/lowerright/
  161.          $7e/$ec);
  162. end;
  163.  
  164. procedure BlockCopy(x1,y1,x2,y2,x3,y3:integer);
  165.  
  166. var
  167.   x4,y4,srcupperleft,srclowerleft,srcupperright,srclowerright,
  168.   destupperleft,destlowerleft,destupperright,destlowerright:integer;
  169.  
  170. begin
  171.   x4:=x3+(x2-x1);
  172.   y4:=y3+(y2-y1);
  173.   srcupperleft:=locate(x1,y1);
  174.   srclowerleft:=locate(x1,y2);
  175.   srcupperright:=locate(x2,y1);
  176.   srclowerright:=locate(x2,y2);
  177.   destupperleft:=locate(x3,y3);
  178.   destlowerleft:=locate(x3,y4);
  179.   destupperright:=locate(x4,y3);
  180.   destlowerright:=locate(x4,y4);
  181.   inline($55/$1e/$8b/$1e/videosegment/$8e/$c3/$8b/$86/x3/$3b/$86/
  182.          x1/$7f/$70/$8b/$86/y3/$3b/$86/y1/$7f/$33/$fc/$8b/$b6/
  183.          srcupperleft/$8b/$be/destupperleft/$8b/$96/x2/$2b/$96/
  184.          x1/$42/$8b/$ae/srclowerright/$8e/$db/$8b/$ca/$f3/$a5/
  185.          $2b/$f2/$2b/$f2/$2b/$fa/$2b/$fa/$81/$c6/$a0/$00/$81/
  186.          $c7/$a0/$00/$3b/$f5/$7e/$e8/$e9/$a0/$00/$fc/$8b/$b6/
  187.          srclowerleft/$8b/$be/destlowerleft/$8b/$96/x2/$2b/$96/
  188.          x1/$42/$8b/$ae/srcupperleft/$8e/$db/$8b/$ca/$f3/$a5/$2b/
  189.          $f2/$2b/$f2/$2b/$fa/$2b/$fa/$81/$ee/$a0/$00/$81/$ef/$a0/
  190.          $00/$3b/$f5/$7d/$e8/$eb/$6e/$90/$8b/$86/y3/$3b/$86/y1/
  191.          $7f/$33/$fd/$8b/$b6/srcupperright/$8b/$be/
  192.          destupperright/$8b/$96/x2/$2b/$96/x1/$42/$8b/$ae/
  193.          srclowerright/$8e/$db/$8b/$ca/$f3/$a5/$03/$f2/$03/$f2/
  194.          $03/$fa/$03/$fa/$81/$c6/$a0/$00/$81/$c7/$a0/$00/$3b/$f5/
  195.          $7e/$e8/$eb/$31/$90/$fd/$8b/$b6/srclowerright/$8b/$be/
  196.          destlowerright/$8b/$96/x2/$2b/$96/x1/$42/$8b/$ae/
  197.          srcupperleft/$8e/$db/$8b/$ca/$f3/$a5/$03/$f2/$03/$f2/
  198.          $03/$fa/$03/$fa/$81/$ee/$a0/$00/$81/$ef/$a0/$00/$3b/$f5/
  199.          $7d/$e8/$1f/$5d);
  200. end;
  201.  
  202. end.
  203.  
  204.